home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5SRC.ZIP / !Perl / c / mg < prev    next >
Text File  |  1995-06-27  |  24KB  |  1,297 lines
  1. /*    mg.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Sam sat on the ground and put his head in his hands.  'I wish I had never
  12.  * come here, and I don't want to see no more magic,' he said, and fell silent."
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /* Omit -- it causes too much grief on mixed systems.*/
  19. #ifdef I_UNISTD
  20. # include <unistd.h>
  21. #endif
  22.  
  23.  
  24. void
  25. mg_magical(sv)
  26. SV* sv;
  27. {
  28.     MAGIC* mg;
  29.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  30.     MGVTBL* vtbl = mg->mg_virtual;
  31.     if (vtbl) {
  32.         if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
  33.         SvGMAGICAL_on(sv);
  34.         if (vtbl->svt_set)
  35.         SvSMAGICAL_on(sv);
  36.         if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  37.         SvRMAGICAL_on(sv);
  38.     }
  39.     }
  40. }
  41.  
  42. int
  43. mg_get(sv)
  44. SV* sv;
  45. {
  46.     MAGIC* mg;
  47.     U32 savemagic = SvMAGICAL(sv) | SvREADONLY(sv);
  48.  
  49.     assert(SvGMAGICAL(sv));
  50.     SvMAGICAL_off(sv);
  51.     SvREADONLY_off(sv);
  52.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  53.  
  54.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  55.     MGVTBL* vtbl = mg->mg_virtual;
  56.     if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
  57.         (*vtbl->svt_get)(sv, mg);
  58.         if (mg->mg_flags & MGf_GSKIP)
  59.         savemagic = 0;
  60.     }
  61.     }
  62.  
  63.     if (savemagic)
  64.     SvFLAGS(sv) |= savemagic;
  65.     else
  66.     mg_magical(sv);
  67.     if (SvGMAGICAL(sv))
  68.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  69.  
  70.     return 0;
  71. }
  72.  
  73. int
  74. mg_set(sv)
  75. SV* sv;
  76. {
  77.     MAGIC* mg;
  78.     MAGIC* nextmg;
  79.     U32 savemagic = SvMAGICAL(sv);
  80.  
  81.     SvMAGICAL_off(sv);
  82.  
  83.     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  84.     MGVTBL* vtbl = mg->mg_virtual;
  85.     nextmg = mg->mg_moremagic;    /* it may delete itself */
  86.     if (mg->mg_flags & MGf_GSKIP) {
  87.         mg->mg_flags &= ~MGf_GSKIP;    /* setting requires another read */
  88.         savemagic = 0;
  89.     }
  90.     if (vtbl && vtbl->svt_set)
  91.         (*vtbl->svt_set)(sv, mg);
  92.     }
  93.  
  94.     if (SvMAGIC(sv)) {
  95.     if (savemagic)
  96.         SvFLAGS(sv) |= savemagic;
  97.     else
  98.         mg_magical(sv);
  99.     if (SvGMAGICAL(sv))
  100.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  101.     }
  102.  
  103.     return 0;
  104. }
  105.  
  106. U32
  107. mg_len(sv)
  108. SV* sv;
  109. {
  110.     MAGIC* mg;
  111.     char *junk;
  112.     STRLEN len;
  113.  
  114.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  115.     MGVTBL* vtbl = mg->mg_virtual;
  116.     if (vtbl && vtbl->svt_len) {
  117.         U32 savemagic = SvMAGICAL(sv);
  118.  
  119.         SvMAGICAL_off(sv);
  120.         SvFLAGS(sv) |= (SvFLAGS(sv)&(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  121.  
  122.         /* omit MGf_GSKIP -- not changed here */
  123.         len = (*vtbl->svt_len)(sv, mg);
  124.  
  125.         SvFLAGS(sv) |= savemagic;
  126.         if (SvGMAGICAL(sv))
  127.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  128.  
  129.         return len;
  130.     }
  131.     }
  132.  
  133.     junk = SvPV(sv, len);
  134.     return len;
  135. }
  136.  
  137. int
  138. mg_clear(sv)
  139. SV* sv;
  140. {
  141.     MAGIC* mg;
  142.     U32 savemagic = SvMAGICAL(sv);
  143.  
  144.     SvMAGICAL_off(sv);
  145.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  146.  
  147.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  148.     MGVTBL* vtbl = mg->mg_virtual;
  149.     /* omit GSKIP -- never set here */
  150.  
  151.     if (vtbl && vtbl->svt_clear)
  152.         (*vtbl->svt_clear)(sv, mg);
  153.     }
  154.  
  155.     SvFLAGS(sv) |= savemagic;
  156.     if (SvGMAGICAL(sv))
  157.     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  158.  
  159.     return 0;
  160. }
  161.  
  162. MAGIC*
  163. mg_find(sv, type)
  164. SV* sv;
  165. int type;
  166. {
  167.     MAGIC* mg;
  168.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  169.     if (mg->mg_type == type)
  170.         return mg;
  171.     }
  172.     return 0;
  173. }
  174.  
  175. int
  176. mg_copy(sv, nsv, key, klen)
  177. SV* sv;
  178. SV* nsv;
  179. char *key;
  180. STRLEN klen;
  181. {
  182.     int count = 0;
  183.     MAGIC* mg;
  184.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  185.     if (isUPPER(mg->mg_type)) {
  186.         sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
  187.         count++;
  188.     }
  189.     }
  190.     return count;
  191. }
  192.  
  193. int
  194. mg_free(sv)
  195. SV* sv;
  196. {
  197.     MAGIC* mg;
  198.     MAGIC* moremagic;
  199.     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
  200.     MGVTBL* vtbl = mg->mg_virtual;
  201.     moremagic = mg->mg_moremagic;
  202.     if (vtbl && vtbl->svt_free)
  203.         (*vtbl->svt_free)(sv, mg);
  204.     if (mg->mg_ptr && mg->mg_type != 'g')
  205.         Safefree(mg->mg_ptr);
  206.     if (mg->mg_flags & MGf_REFCOUNTED)
  207.         SvREFCNT_dec(mg->mg_obj);
  208.     Safefree(mg);
  209.     }
  210.     SvMAGIC(sv) = 0;
  211.     return 0;
  212. }
  213.  
  214. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  215. #include <signal.h>
  216. #endif
  217.  
  218. U32
  219. magic_len(sv, mg)
  220. SV *sv;
  221. MAGIC *mg;
  222. {
  223.     register I32 paren;
  224.     register char *s;
  225.     register I32 i;
  226.     char *t;
  227.  
  228.     switch (*mg->mg_ptr) {
  229.     case '1': case '2': case '3': case '4':
  230.     case '5': case '6': case '7': case '8': case '9': case '&':
  231.     if (curpm) {
  232.         paren = atoi(mg->mg_ptr);
  233.       getparen:
  234.         if (curpm->op_pmregexp &&
  235.           paren <= curpm->op_pmregexp->nparens &&
  236.           (s = curpm->op_pmregexp->startp[paren]) &&
  237.           (t = curpm->op_pmregexp->endp[paren]) ) {
  238.         i = t - s;
  239.         if (i >= 0)
  240.             return i;
  241.         }
  242.     }
  243.     return 0;
  244.     break;
  245.     case '+':
  246.     if (curpm) {
  247.         paren = curpm->op_pmregexp->lastparen;
  248.         if (!paren)
  249.         return 0;
  250.         goto getparen;
  251.     }
  252.     return 0;
  253.     break;
  254.     case '`':
  255.     if (curpm) {
  256.         if (curpm->op_pmregexp &&
  257.           (s = curpm->op_pmregexp->subbeg) ) {
  258.         i = curpm->op_pmregexp->startp[0] - s;
  259.         if (i >= 0)
  260.             return i;
  261.         }
  262.     }
  263.     return 0;
  264.     case '\'':
  265.     if (curpm) {
  266.         if (curpm->op_pmregexp &&
  267.           (s = curpm->op_pmregexp->endp[0]) ) {
  268.         return (STRLEN) (curpm->op_pmregexp->subend - s);
  269.         }
  270.     }
  271.     return 0;
  272.     case ',':
  273.     return (STRLEN)ofslen;
  274.     case '\\':
  275.     return (STRLEN)orslen;
  276.     }
  277.     magic_get(sv,mg);
  278.     if (!SvPOK(sv) && SvNIOK(sv))
  279.     sv_2pv(sv, &na);
  280.     if (SvPOK(sv))
  281.     return SvCUR(sv);
  282.     return 0;
  283. }
  284.  
  285. int
  286. magic_get(sv, mg)
  287. SV *sv;
  288. MAGIC *mg;
  289. {
  290.     register I32 paren;
  291.     register char *s;
  292.     register I32 i;
  293.     char *t;
  294.  
  295.     switch (*mg->mg_ptr) {
  296.     case '\001':        /* ^A */
  297.     sv_setsv(sv, bodytarget);
  298.     break;
  299.     case '\004':        /* ^D */
  300.     sv_setiv(sv,(I32)(debug & 32767));
  301.     break;
  302.     case '\006':        /* ^F */
  303.     sv_setiv(sv,(I32)maxsysfd);
  304.     break;
  305.     case '\010':        /* ^H */
  306.     sv_setiv(sv,(I32)hints);
  307.     break;
  308.     case '\t':            /* ^I */
  309.     if (inplace)
  310.         sv_setpv(sv, inplace);
  311.     else
  312.         sv_setsv(sv,&sv_undef);
  313.     break;
  314.     case '\020':        /* ^P */
  315.     sv_setiv(sv,(I32)perldb);
  316.     break;
  317.     case '\024':        /* ^T */
  318.     sv_setiv(sv,(I32)basetime);
  319.     break;
  320.     case '\027':        /* ^W */
  321.     sv_setiv(sv,(I32)dowarn);
  322.     break;
  323.     case '1': case '2': case '3': case '4':
  324.     case '5': case '6': case '7': case '8': case '9': case '&':
  325.     if (curpm) {
  326.         paren = atoi(GvENAME(mg->mg_obj));
  327.       getparen:
  328.         if (curpm->op_pmregexp &&
  329.           paren <= curpm->op_pmregexp->nparens &&
  330.           (s = curpm->op_pmregexp->startp[paren]) &&
  331.           (t = curpm->op_pmregexp->endp[paren]) ) {
  332.         i = t - s;
  333.         if (i >= 0) {
  334.             MAGIC *tmg;
  335.             sv_setpvn(sv,s,i);
  336.             if (tainting && (tmg = mg_find(sv,'t')))
  337.             tmg->mg_len = 0;    /* guarantee $1 untainted */
  338.             break;
  339.         }
  340.         }
  341.     }
  342.     sv_setsv(sv,&sv_undef);
  343.     break;
  344.     case '+':
  345.     if (curpm) {
  346.         paren = curpm->op_pmregexp->lastparen;
  347.         if (paren)
  348.         goto getparen;
  349.     }
  350.     sv_setsv(sv,&sv_undef);
  351.     break;
  352.     case '`':
  353.     if (curpm) {
  354.         if (curpm->op_pmregexp &&
  355.           (s = curpm->op_pmregexp->subbeg) ) {
  356.         i = curpm->op_pmregexp->startp[0] - s;
  357.         if (i >= 0) {
  358.             sv_setpvn(sv,s,i);
  359.             break;
  360.         }
  361.         }
  362.     }
  363.     sv_setsv(sv,&sv_undef);
  364.     break;
  365.     case '\'':
  366.     if (curpm) {
  367.         if (curpm->op_pmregexp &&
  368.           (s = curpm->op_pmregexp->endp[0]) ) {
  369.         sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
  370.         break;
  371.         }
  372.     }
  373.     sv_setsv(sv,&sv_undef);
  374.     break;
  375.     case '.':
  376. #ifndef lint
  377.     if (GvIO(last_in_gv)) {
  378.         sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
  379.     }
  380. #endif
  381.     break;
  382.     case '?':
  383.     sv_setiv(sv,(I32)statusvalue);
  384.     break;
  385.     case '^':
  386.     s = IoTOP_NAME(GvIOp(defoutgv));
  387.     if (s)
  388.         sv_setpv(sv,s);
  389.     else {
  390.         sv_setpv(sv,GvENAME(defoutgv));
  391.         sv_catpv(sv,"_TOP");
  392.     }
  393.     break;
  394.     case '~':
  395.     s = IoFMT_NAME(GvIOp(defoutgv));
  396.     if (!s)
  397.         s = GvENAME(defoutgv);
  398.     sv_setpv(sv,s);
  399.     break;
  400. #ifndef lint
  401.     case '=':
  402.     sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
  403.     break;
  404.     case '-':
  405.     sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
  406.     break;
  407.     case '%':
  408.     sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
  409.     break;
  410. #endif
  411.     case ':':
  412.     break;
  413.     case '/':
  414.     break;
  415.     case '[':
  416.     sv_setiv(sv,(I32)curcop->cop_arybase);
  417.     break;
  418.     case '|':
  419.     sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
  420.     break;
  421.     case ',':
  422.     sv_setpvn(sv,ofs,ofslen);
  423.     break;
  424.     case '\\':
  425.     sv_setpvn(sv,ors,orslen);
  426.     break;
  427.     case '#':
  428.     sv_setpv(sv,ofmt);
  429.     break;
  430.     case '!':
  431.     sv_setnv(sv,(double)errno);
  432.     sv_setpv(sv, errno ? Strerror(errno) : "");
  433.     SvNOK_on(sv);    /* what a wonderful hack! */
  434.     break;
  435.     case '<':
  436.     sv_setiv(sv,(I32)uid);
  437.     break;
  438.     case '>':
  439.     sv_setiv(sv,(I32)euid);
  440.     break;
  441.     case '(':
  442.     s = buf;
  443.     (void)sprintf(s,"%d",(int)gid);
  444.     goto add_groups;
  445.     case ')':
  446.     s = buf;
  447.     (void)sprintf(s,"%d",(int)egid);
  448.       add_groups:
  449.     while (*s) s++;
  450. #ifdef HAS_GETGROUPS
  451. #ifndef NGROUPS
  452. #define NGROUPS 32
  453. #endif
  454.     {
  455.         Groups_t gary[NGROUPS];
  456.  
  457.         i = getgroups(NGROUPS,gary);
  458.         while (--i >= 0) {
  459.         (void)sprintf(s," %ld", (long)gary[i]);
  460.         while (*s) s++;
  461.         }
  462.     }
  463. #endif
  464.     sv_setpv(sv,buf);
  465.     break;
  466.     case '*':
  467.     break;
  468.     case '0':
  469.     break;
  470.     }
  471.     return 0;
  472. }
  473.  
  474. int
  475. magic_getuvar(sv, mg)
  476. SV *sv;
  477. MAGIC *mg;
  478. {
  479.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  480.  
  481.     if (uf && uf->uf_val)
  482.     (*uf->uf_val)(uf->uf_index, sv);
  483.     return 0;
  484. }
  485.  
  486. int
  487. magic_setenv(sv,mg)
  488. SV* sv;
  489. MAGIC* mg;
  490. {
  491.     register char *s;
  492.     STRLEN len;
  493.     I32 i;
  494.     s = SvPV(sv,len);
  495.     my_setenv(mg->mg_ptr,s);
  496. #ifdef DYNAMIC_ENV_FETCH
  497.      /* We just undefd an environment var.  Is a replacement */
  498.      /* waiting in the wings? */
  499.     if (!len) {
  500.     SV **envsvp;
  501.     if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
  502.         s = SvPV(*envsvp,len);
  503.     }
  504. #endif
  505.                 /* And you'll never guess what the dog had */
  506.                 /*   in its mouth... */
  507.     if (tainting) {
  508.     if (s && strEQ(mg->mg_ptr,"PATH")) {
  509.         char *strend = s + len;
  510.  
  511.         while (s < strend) {
  512.         s = cpytill(tokenbuf,s,strend,':',&i);
  513.         s++;
  514.         if (*tokenbuf != '/'
  515.           || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  516.             MgTAINTEDDIR_on(mg);
  517.         }
  518.     }
  519.     }
  520.     return 0;
  521. }
  522.  
  523. int
  524. magic_clearenv(sv,mg)
  525. SV* sv;
  526. MAGIC* mg;
  527. {
  528.     my_setenv(mg->mg_ptr,Nullch);
  529.     return 0;
  530. }
  531.  
  532. int
  533. magic_setsig(sv,mg)
  534. SV* sv;
  535. MAGIC* mg;
  536. {
  537.     register char *s;
  538.     I32 i;
  539.     SV** svp;
  540.  
  541.     s = mg->mg_ptr;
  542.     if (*s == '_') {
  543.     if (strEQ(s,"__DIE__"))
  544.         svp = &diehook;
  545.     else if (strEQ(s,"__WARN__"))
  546.         svp = &warnhook;
  547.     else if (strEQ(s,"__PARSE__"))
  548.         svp = &parsehook;
  549.     else
  550.         croak("No such hook: %s", s);
  551.     i = 0;
  552.     }
  553.     else {
  554.     i = whichsig(s);    /* ...no, a brick */
  555.     if (!i) {
  556.         if (dowarn || strEQ(s,"ALARM"))
  557.         warn("No such signal: SIG%s", s);
  558.         return 0;
  559.     }
  560.     }
  561.     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
  562.     if (i)
  563.         (void)signal(i,sighandler);
  564.     else
  565.         *svp = SvREFCNT_inc(sv);
  566.     return 0;
  567.     }
  568.     s = SvPV_force(sv,na);
  569.     if (strEQ(s,"IGNORE")) {
  570.     if (i)
  571.         (void)signal(i,SIG_IGN);
  572.     else
  573.         *svp = 0;
  574.     }
  575.     else if (strEQ(s,"DEFAULT") || !*s) {
  576.     if (i)
  577.         (void)signal(i,SIG_DFL);
  578.     else
  579.         *svp = 0;
  580.     }
  581.     else {
  582.     if (!strchr(s,':') && !strchr(s,'\'')) {
  583.         sprintf(tokenbuf, "main::%s",s);
  584.         sv_setpv(sv,tokenbuf);
  585.     }
  586.     if (i)
  587.         (void)signal(i,sighandler);
  588.     else
  589.         *svp = SvREFCNT_inc(sv);
  590.     }
  591.     return 0;
  592. }
  593.  
  594. int
  595. magic_setisa(sv,mg)
  596. SV* sv;
  597. MAGIC* mg;
  598. {
  599.     sub_generation++;
  600.     return 0;
  601. }
  602.  
  603. #ifdef OVERLOAD
  604.  
  605. int
  606. magic_setamagic(sv,mg)
  607. SV* sv;
  608. MAGIC* mg;
  609. {
  610.     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
  611.     amagic_generation++;
  612.  
  613.     return 0;
  614. }
  615. #endif /* OVERLOAD */
  616.  
  617. static int
  618. magic_methpack(sv,mg,meth)
  619. SV* sv;
  620. MAGIC* mg;
  621. char *meth;
  622. {
  623.     dSP;
  624.  
  625.     ENTER;
  626.     SAVETMPS;
  627.     PUSHMARK(sp);
  628.     EXTEND(sp, 2);
  629.     PUSHs(mg->mg_obj);
  630.     if (mg->mg_ptr)
  631.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  632.     else if (mg->mg_type == 'p')
  633.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  634.     PUTBACK;
  635.  
  636.     if (perl_call_method(meth, G_SCALAR))
  637.     sv_setsv(sv, *stack_sp--);
  638.  
  639.     FREETMPS;
  640.     LEAVE;
  641.     return 0;
  642. }
  643.  
  644. int
  645. magic_getpack(sv,mg)
  646. SV* sv;
  647. MAGIC* mg;
  648. {
  649.     magic_methpack(sv,mg,"FETCH");
  650.     if (mg->mg_ptr)
  651.     mg->mg_flags |= MGf_GSKIP;
  652.     return 0;
  653. }
  654.  
  655. int
  656. magic_setpack(sv,mg)
  657. SV* sv;
  658. MAGIC* mg;
  659. {
  660.     dSP;
  661.  
  662.     PUSHMARK(sp);
  663.     EXTEND(sp, 3);
  664.     PUSHs(mg->mg_obj);
  665.     if (mg->mg_ptr)
  666.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  667.     else if (mg->mg_type == 'p')
  668.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  669.     PUSHs(sv);
  670.     PUTBACK;
  671.  
  672.     perl_call_method("STORE", G_SCALAR|G_DISCARD);
  673.  
  674.     return 0;
  675. }
  676.  
  677. int
  678. magic_clearpack(sv,mg)
  679. SV* sv;
  680. MAGIC* mg;
  681. {
  682.     return magic_methpack(sv,mg,"DELETE");
  683. }
  684.  
  685. int magic_wipepack(sv,mg)
  686. SV* sv;
  687. MAGIC* mg;
  688. {
  689.     dSP;
  690.  
  691.     PUSHMARK(sp);
  692.     XPUSHs(mg->mg_obj);
  693.     PUTBACK;
  694.  
  695.     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
  696.  
  697.     return 0;
  698. }
  699.  
  700. int
  701. magic_nextpack(sv,mg,key)
  702. SV* sv;
  703. MAGIC* mg;
  704. SV* key;
  705. {
  706.     dSP;
  707.     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
  708.  
  709.     ENTER;
  710.     SAVETMPS;
  711.     PUSHMARK(sp);
  712.     EXTEND(sp, 2);
  713.     PUSHs(mg->mg_obj);
  714.     if (SvOK(key))
  715.     PUSHs(key);
  716.     PUTBACK;
  717.  
  718.     if (perl_call_method(meth, G_SCALAR))
  719.     sv_setsv(key, *stack_sp--);
  720.  
  721.     FREETMPS;
  722.     LEAVE;
  723.     return 0;
  724. }
  725.  
  726. int
  727. magic_existspack(sv,mg)
  728. SV* sv;
  729. MAGIC* mg;
  730. {
  731.     return magic_methpack(sv,mg,"EXISTS");
  732. }
  733.  
  734. int
  735. magic_setdbline(sv,mg)
  736. SV* sv;
  737. MAGIC* mg;
  738. {
  739.     OP *o;
  740.     I32 i;
  741.     GV* gv;
  742.     SV** svp;
  743.  
  744.     gv = DBline;
  745.     i = SvTRUE(sv);
  746.     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
  747.     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
  748.     o->op_private = i;
  749.     else
  750.     warn("Can't break at that line\n");
  751.     return 0;
  752. }
  753.  
  754. int
  755. magic_getarylen(sv,mg)
  756. SV* sv;
  757. MAGIC* mg;
  758. {
  759.     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
  760.     return 0;
  761. }
  762.  
  763. int
  764. magic_setarylen(sv,mg)
  765. SV* sv;
  766. MAGIC* mg;
  767. {
  768.     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
  769.     return 0;
  770. }
  771.  
  772. int
  773. magic_getpos(sv,mg)
  774. SV* sv;
  775. MAGIC* mg;
  776. {
  777.     SV* lsv = LvTARG(sv);
  778.  
  779.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
  780.     mg = mg_find(lsv, 'g');
  781.     if (mg && mg->mg_len >= 0) {
  782.         sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
  783.         return 0;
  784.     }
  785.     }
  786.     (void)SvOK_off(sv);
  787.     return 0;
  788. }
  789.  
  790. int
  791. magic_setpos(sv,mg)
  792. SV* sv;
  793. MAGIC* mg;
  794. {
  795.     SV* lsv = LvTARG(sv);
  796.     SSize_t pos;
  797.     STRLEN len;
  798.  
  799.     mg = 0;
  800.  
  801.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
  802.     mg = mg_find(lsv, 'g');
  803.     if (!mg) {
  804.     if (!SvOK(sv))
  805.         return 0;
  806.     sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
  807.     mg = mg_find(lsv, 'g');
  808.     }
  809.     else if (!SvOK(sv)) {
  810.     mg->mg_len = -1;
  811.     return 0;
  812.     }
  813.     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
  814.  
  815.     pos = SvIV(sv) - curcop->cop_arybase;
  816.     if (pos < 0) {
  817.     pos += len;
  818.     if (pos < 0)
  819.         pos = 0;
  820.     }
  821.     else if (pos > len)
  822.     pos = len;
  823.     mg->mg_len = pos;
  824.  
  825.     return 0;
  826. }
  827.  
  828. int
  829. magic_getglob(sv,mg)
  830. SV* sv;
  831. MAGIC* mg;
  832. {
  833.     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
  834.     return 0;
  835. }
  836.  
  837. int
  838. magic_setglob(sv,mg)
  839. SV* sv;
  840. MAGIC* mg;
  841. {
  842.     register char *s;
  843.     GV* gv;
  844.  
  845.     if (!SvOK(sv))
  846.     return 0;
  847.     s = SvPV(sv, na);
  848.     if (*s == '*' && s[1])
  849.     s++;
  850.     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
  851.     if (sv == (SV*)gv)
  852.     return 0;
  853.     if (GvGP(sv))
  854.     gp_free(sv);
  855.     GvGP(sv) = gp_ref(GvGP(gv));
  856.     if (!GvAV(gv))
  857.     gv_AVadd(gv);
  858.     if (!GvHV(gv))
  859.     gv_HVadd(gv);
  860.     if (!GvIOp(gv))
  861.     GvIOp(gv) = newIO();
  862.     return 0;
  863. }
  864.  
  865. int
  866. magic_setsubstr(sv,mg)
  867. SV* sv;
  868. MAGIC* mg;
  869. {
  870.     STRLEN len;
  871.     char *tmps = SvPV(sv,len);
  872.     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
  873.     return 0;
  874. }
  875.  
  876. int
  877. magic_gettaint(sv,mg)
  878. SV* sv;
  879. MAGIC* mg;
  880. {
  881.     if (mg->mg_len & 1)
  882.     tainted = TRUE;
  883.     else if (mg->mg_len & 2 && mg->mg_obj == sv)    /* kludge */
  884.     tainted = TRUE;
  885.     return 0;
  886. }
  887.  
  888. int
  889. magic_settaint(sv,mg)
  890. SV* sv;
  891. MAGIC* mg;
  892. {
  893.     if (localizing) {
  894.     if (localizing == 1)
  895.         mg->mg_len <<= 1;
  896.     else
  897.         mg->mg_len >>= 1;
  898.     }
  899.     else if (tainted)
  900.     mg->mg_len |= 1;
  901.     else
  902.     mg->mg_len &= ~1;
  903.     return 0;
  904. }
  905.  
  906. int
  907. magic_setvec(sv,mg)
  908. SV* sv;
  909. MAGIC* mg;
  910. {
  911.     do_vecset(sv);    /* XXX slurp this routine */
  912.     return 0;
  913. }
  914.  
  915. int
  916. magic_setmglob(sv,mg)
  917. SV* sv;
  918. MAGIC* mg;
  919. {
  920.     mg->mg_len = -1;
  921.     return 0;
  922. }
  923.  
  924. int
  925. magic_setbm(sv,mg)
  926. SV* sv;
  927. MAGIC* mg;
  928. {
  929.     sv_unmagic(sv, 'B');
  930.     SvVALID_off(sv);
  931.     return 0;
  932. }
  933.  
  934. int
  935. magic_setuvar(sv,mg)
  936. SV* sv;
  937. MAGIC* mg;
  938. {
  939.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  940.  
  941.     if (uf && uf->uf_set)
  942.     (*uf->uf_set)(uf->uf_index, sv);
  943.     return 0;
  944. }
  945.  
  946. int
  947. magic_set(sv,mg)
  948. SV* sv;
  949. MAGIC* mg;
  950. {
  951.     register char *s;
  952.     I32 i;
  953.     STRLEN len;
  954.     switch (*mg->mg_ptr) {
  955.     case '\001':    /* ^A */
  956.     sv_setsv(bodytarget, sv);
  957.     break;
  958.     case '\004':    /* ^D */
  959.     debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  960.     DEBUG_x(dump_all());
  961.     break;
  962.     case '\006':    /* ^F */
  963.     maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  964.     break;
  965.     case '\010':    /* ^H */
  966.     hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  967.     break;
  968.     case '\t':    /* ^I */
  969.     if (inplace)
  970.         Safefree(inplace);
  971.     if (SvOK(sv))
  972.         inplace = savepv(SvPV(sv,na));
  973.     else
  974.         inplace = Nullch;
  975.     break;
  976.     case '\020':    /* ^P */
  977.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  978.     if (i != perldb) {
  979.         if (perldb)
  980.         oldlastpm = curpm;
  981.         else
  982.         curpm = oldlastpm;
  983.     }
  984.     perldb = i;
  985.     break;
  986.     case '\024':    /* ^T */
  987.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  988.     break;
  989.     case '\027':    /* ^W */
  990.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  991.     break;
  992.     case '.':
  993.     if (localizing) {
  994.         if (localizing == 1)
  995.         save_sptr((SV**)&last_in_gv);
  996.     }
  997.     else if (SvOK(sv))
  998.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  999.     break;
  1000.     case '^':
  1001.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  1002.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1003.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1004.     break;
  1005.     case '~':
  1006.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  1007.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1008.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1009.     break;
  1010.     case '=':
  1011.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1012.     break;
  1013.     case '-':
  1014.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1015.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  1016.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  1017.     break;
  1018.     case '%':
  1019.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1020.     break;
  1021.     case '|':
  1022.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  1023.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  1024.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  1025.     }
  1026.     break;
  1027.     case '*':
  1028.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1029.     multiline = (i != 0);
  1030.     break;
  1031.     case '/':
  1032.     if (SvOK(sv)) {
  1033.         nrs = rs = SvPV_force(sv,rslen);
  1034.         nrslen = rslen;
  1035.         if (rspara = !rslen) {
  1036.         nrs = rs = "\n\n";
  1037.         nrslen = rslen = 2;
  1038.         }
  1039.         nrschar = rschar = rs[rslen - 1];
  1040.     }
  1041.     else {
  1042.         nrschar = rschar = 0777;    /* fake a non-existent char */
  1043.         nrslen = rslen = 1;
  1044.     }
  1045.     break;
  1046.     case '\\':
  1047.     if (ors)
  1048.         Safefree(ors);
  1049.     ors = savepv(SvPV(sv,orslen));
  1050.     break;
  1051.     case ',':
  1052.     if (ofs)
  1053.         Safefree(ofs);
  1054.     ofs = savepv(SvPV(sv, ofslen));
  1055.     break;
  1056.     case '#':
  1057.     if (ofmt)
  1058.         Safefree(ofmt);
  1059.     ofmt = savepv(SvPV(sv,na));
  1060.     break;
  1061.     case '[':
  1062.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1063.     break;
  1064.     case '?':
  1065.     statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1066.     break;
  1067.     case '!':
  1068.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SS$_ABORT);        /* will anyone ever use this? */
  1069.     break;
  1070. #ifndef RISCOS
  1071.     case '<':
  1072.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1073.     if (delaymagic) {
  1074.         delaymagic |= DM_RUID;
  1075.         break;                /* don't do magic till later */
  1076.     }
  1077. #ifdef HAS_SETRUID
  1078.     (void)setruid((Uid_t)uid);
  1079. #else
  1080. #ifdef HAS_SETREUID
  1081.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1082. #else
  1083. #ifdef HAS_SETRESUID
  1084.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1085. #else
  1086.     if (uid == euid)        /* special case $< = $> */
  1087.         (void)setuid(uid);
  1088.     else {
  1089.         uid = (I32)getuid();
  1090.         croak("setruid() not implemented");
  1091.     }
  1092. #endif
  1093. #endif
  1094. #endif
  1095.     uid = (I32)getuid();
  1096.     tainting |= (euid != uid || egid != gid);
  1097.     break;
  1098.     case '>':
  1099.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1100.     if (delaymagic) {
  1101.         delaymagic |= DM_EUID;
  1102.         break;                /* don't do magic till later */
  1103.     }
  1104. #ifdef HAS_SETEUID
  1105.     (void)seteuid((Uid_t)euid);
  1106. #else
  1107. #ifdef HAS_SETREUID
  1108.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1109. #else
  1110. #ifdef HAS_SETRESUID
  1111.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1112. #else
  1113.     if (euid == uid)        /* special case $> = $< */
  1114.         setuid(euid);
  1115.     else {
  1116.         euid = (I32)geteuid();
  1117.         croak("seteuid() not implemented");
  1118.     }
  1119. #endif
  1120. #endif
  1121. #endif
  1122.     euid = (I32)geteuid();
  1123.     tainting |= (euid != uid || egid != gid);
  1124.     break;
  1125.     case '(':
  1126.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1127.     if (delaymagic) {
  1128.         delaymagic |= DM_RGID;
  1129.         break;                /* don't do magic till later */
  1130.     }
  1131. #ifdef HAS_SETRGID
  1132.     (void)setrgid((Gid_t)gid);
  1133. #else
  1134. #ifdef HAS_SETREGID
  1135.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1136. #else
  1137. #ifdef HAS_SETRESGID
  1138.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1139. #else
  1140.     if (gid == egid)            /* special case $( = $) */
  1141.         (void)setgid(gid);
  1142.     else {
  1143.         gid = (I32)getgid();
  1144.         croak("setrgid() not implemented");
  1145.     }
  1146. #endif
  1147. #endif
  1148. #endif
  1149.     gid = (I32)getgid();
  1150.     tainting |= (euid != uid || egid != gid);
  1151.     break;
  1152.     case ')':
  1153.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1154.     if (delaymagic) {
  1155.         delaymagic |= DM_EGID;
  1156.         break;                /* don't do magic till later */
  1157.     }
  1158. #ifdef HAS_SETEGID
  1159.     (void)setegid((Gid_t)egid);
  1160. #else
  1161. #ifdef HAS_SETREGID
  1162.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1163. #else
  1164. #ifdef HAS_SETRESGID
  1165.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1166. #else
  1167.     if (egid == gid)            /* special case $) = $( */
  1168.         (void)setgid(egid);
  1169.     else {
  1170.         egid = (I32)getegid();
  1171.         croak("setegid() not implemented");
  1172.     }
  1173. #endif
  1174. #endif
  1175. #endif
  1176.     egid = (I32)getegid();
  1177.     tainting |= (euid != uid || egid != gid);
  1178.     break;
  1179.     case ':':
  1180.     chopset = SvPV_force(sv,na);
  1181.     break;
  1182.     case '0':
  1183.     if (!origalen) {
  1184.         s = origargv[0];
  1185.         s += strlen(s);
  1186.         /* See if all the arguments are contiguous in memory */
  1187.         for (i = 1; i < origargc; i++) {
  1188.         if (origargv[i] == s + 1)
  1189.             s += strlen(++s);    /* this one is ok too */
  1190.         }
  1191.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1192.         my_setenv("NoNeSuCh", Nullch);
  1193.                         /* force copy of environment */
  1194.         for (i = 0; origenviron[i]; i++)
  1195.             if (origenviron[i] == s + 1)
  1196.             s += strlen(++s);
  1197.         }
  1198.         origalen = s - origargv[0];
  1199.     }
  1200.     s = SvPV_force(sv,len);
  1201.     i = len;
  1202.     if (i >= origalen) {
  1203.         i = origalen;
  1204.         SvCUR_set(sv, i);
  1205.         *SvEND(sv) = '\0';
  1206.         Copy(s, origargv[0], i, char);
  1207.     }
  1208.     else {
  1209.         Copy(s, origargv[0], i, char);
  1210.         s = origargv[0]+i;
  1211.         *s++ = '\0';
  1212.         while (++i < origalen)
  1213.         *s++ = ' ';
  1214.         s = origargv[0]+i;
  1215.         for (i = 1; i < origargc; i++)
  1216.         origargv[i] = Nullch;
  1217.     }
  1218.     break;
  1219. #endif /* RISCOS */
  1220.     }
  1221.     return 0;
  1222. }
  1223.  
  1224. I32
  1225. whichsig(sig)
  1226. char *sig;
  1227. {
  1228.     register char **sigv;
  1229.  
  1230.     for (sigv = sig_name+1; *sigv; sigv++)
  1231.     if (strEQ(sig,*sigv))
  1232.         return sigv - sig_name;
  1233. #ifdef SIGCLD
  1234.     if (strEQ(sig,"CHLD"))
  1235.     return SIGCLD;
  1236. #endif
  1237. #ifdef SIGCHLD
  1238.     if (strEQ(sig,"CLD"))
  1239.     return SIGCHLD;
  1240. #endif
  1241.     return 0;
  1242. }
  1243.  
  1244. Signal_t
  1245. sighandler(sig)
  1246. int sig;
  1247. {
  1248.     dSP;
  1249.     GV *gv;
  1250.     HV *st;
  1251.     SV *sv;
  1252.     CV *cv;
  1253.     AV *oldstack;
  1254.  
  1255. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1256.     signal(sig, SIG_ACK);
  1257. #endif
  1258.  
  1259.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
  1260.               TRUE),
  1261.         &st, &gv, TRUE);
  1262.     if (!cv || !CvROOT(cv) &&
  1263.     *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  1264.  
  1265.     if (sig_name[sig][1] == 'H')
  1266.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1267.             &st, &gv, TRUE);
  1268.     else
  1269.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1270.             &st, &gv, TRUE);
  1271.     /* gag */
  1272.     }
  1273.     if (!cv || !CvROOT(cv)) {
  1274.     if (dowarn)
  1275.         warn("SIG%s handler \"%s\" not defined.\n",
  1276.         sig_name[sig], GvENAME(gv) );
  1277.     return;
  1278.     }
  1279.  
  1280.     oldstack = stack;
  1281.     if (stack != signalstack)
  1282.     AvFILL(signalstack) = 0;
  1283.     SWITCHSTACK(stack, signalstack);
  1284.  
  1285.     sv = sv_newmortal();
  1286.     sv_setpv(sv,sig_name[sig]);
  1287.     PUSHMARK(sp);
  1288.     PUSHs(sv);
  1289.     PUTBACK;
  1290.  
  1291.     perl_call_sv((SV*)cv, G_DISCARD);
  1292.  
  1293.     SWITCHSTACK(signalstack, oldstack);
  1294.  
  1295.     return;
  1296. }
  1297.